home *** CD-ROM | disk | FTP | other *** search
/ Amiga Collections: R-H-S / R-H-S Tools 27 (19xx)(Reiner Hobbold Software)(DE)(PD).zip / R-H-S Tools 27 (19xx)(Reiner Hobbold Software)(DE)(PD).adf / Main (.txt) < prev    next >
AmigaBASIC Source Code  |  1978-01-03  |  18KB  |  623 lines
  1. SCREEN 1,640,220,4,2
  2. WINDOW 1," Quizmaster      Version 2.0                     written in 1989 by F. Zöllner",,0,1
  3. PALETTE 0,0,0,0:PALETTE 1,0,0,0.75:PALETTE 2,1,1,1
  4. PALETTE 3,1,0,0:PALETTE 4,0,1,0:PALETTE 5,0.4,0.4,1
  5. PALETTE 6,1,1,0:PALETTE 7,0,1,1:PALETTE 8,0,0,0.3
  6. PALETTE 9,0.75,0.75,0.75:PALETTE 15,1,1,1
  7. PALETTE 10,0,1,1:PALETTE 11,0.4,0,0.4
  8. PALETTE 12,0.6,0,0.6:PALETTE 13,1,0,1
  9. PALETTE 14,0.8,0.8,1:pr$="·"
  10. pal(1)=0:pal(2)=0:pal(3)=0.75
  11. pala(1)=0:pala(2)=0:pala(3)=0.3
  12. RANDOMIZE TIMER
  13. DIM feld(40)
  14. DIM gen(40)
  15. FOR i=1 TO 4:score(i)=100:NEXT i
  16. :::
  17.  ::                 :
  18.   :                ::       :::::
  19.    risiko =   5   : :      :   :
  20.    joker  =   5  :  :::::::::::
  21.    max    = 300   : :      :   :
  22.   :                ::       ::::: 
  23.  ::                 :
  24. ::: 
  25. LINE (12,6)-(618,200),1,b:PAINT (1,1),1,1
  26. LINE (8,4)-(622,202),0,b:LINE (7,4)-(620,202),0,b
  27. FOR t=1 TO 4
  28. FOR i=1 TO 10:COLOR 7:LOCATE 1+t*2,40+3*i:PRINT "?":NEXT i,t
  29. FOR t=0 TO 3:FOR i=0 TO 9
  30. LINE (330+i*24,13+t*16)-(350+i*24,26+t*16),1,b
  31. NEXT i,t
  32. LINE (324,10)-(572,77),1,b:LINE (323,10)-(573,77),1,b
  33. LINE (36,181)-(590,193),1,b:LINE (35,181)-(591,193),1,b
  34. COLOR 1:LOCATE 24,7:PRINT ">"  
  35. COLOR 3:LOCATE 3,5:PRINT "Spieler 1 :"  
  36. COLOR 4:LOCATE 4,5:PRINT "Spieler 2 :"
  37. COLOR 5:LOCATE 5,5:PRINT "Spieler 3 :"
  38. COLOR 6:LOCATE 6,5:PRINT "Spieler 4 :"
  39. LINE (24,13)-(280,50),1,b:LINE (20,11)-(284,52),1,b
  40. COLOR 7:LOCATE 9,5:PRINT "Zeit :"
  41. LINE (24,60)-(280,74),1,b:LINE (20,58)-(284,76),1,b
  42. LINE (84,58)-(88,76),1,b 
  43. LOCATE 12,5:PRINT "Frage :"
  44. LINE (24,85)-(604,97),1,b:LINE (23,85)-(605,97),1,b
  45. LOCATE 14,5:PRINT "Antworten :"
  46. LINE (24,100)-(604,162),1,b
  47. LOCATE 14,18:PRINT "(1)"
  48. LOCATE 16,18:PRINT "(2)"
  49. LOCATE 18,18:PRINT "(3)"
  50. LOCATE 20,18:PRINT "(4)"
  51. PAINT (14,7),8,1
  52. LOCATE 12,14:COLOR 2
  53. PRINT "Wieviele Mitspieler wünschen Sie ?"
  54. ant$(1)="Einen":ant$(2)="Zwei":ant$(3)="Drei":ant$(4)="Vier"
  55. GOSUB Antworten:sonder=1:ant=1:GOSUB Auswahl:sonder=0
  56. IF ant<4 THEN LOCATE 6,5:PRINT "            "
  57. IF ant<3 THEN LOCATE 5,5:PRINT "            "
  58. IF ant<2 THEN LOCATE 4,5:PRINT "            "
  59. anz=ant
  60. GOSUB Clearen
  61. GOTO Quiz
  62.  
  63. Quiz:
  64. FOR i=1 TO joker
  65. Objoker: a=INT(40*RND(1))+1
  66. IF feld(a)<>0 THEN GOTO Objoker
  67. feld(a)=3:NEXT i
  68. FOR i=1 TO risiko
  69. Obrisiko: a=INT(40*RND(1))+1
  70. IF feld(a)<>0 THEN GOTO Obrisiko
  71. feld(a)=4:NEXT i
  72.  
  73. Start:
  74. FOR ass=1 TO anz
  75. LOCATE 3,18:COLOR 2:PRINT score(1)
  76. IF anz>1 THEN LOCATE 4,18:COLOR 2:PRINT score(2)
  77. IF anz>2 THEN LOCATE 5,18:COLOR 2:PRINT score(3)
  78. IF anz>3 THEN LOCATE 6,18:COLOR 2:PRINT score(4)
  79. Okay:
  80. LOCATE 24,9:COLOR ass+2:PRINT "Spieler"ass", wählen Sie ein freies Feld !"
  81. GOSUB Eingabe
  82. IF feld(wahl)=1 THEN GOTO Fehler
  83. IF feld(wahl)=3 THEN GOTO Jokerda
  84. IF feld(wahl)=4 THEN GOTO Risikoda
  85. GOSUB Fragelesen
  86. ok=LEN(frage$)
  87. IF ok<59 THEN FOR i=1 TO 62-ok:frage$=frage$+" ":NEXT i
  88. LOCATE 12,14:COLOR 2:PRINT frage$
  89. GOSUB Antworten
  90. ant=1:GOSUB Auswahl
  91. IF ant<>wahr THEN GOSUB FalscheAntwort:GOTO Okay1
  92. IF ant=wahr THEN GOSUB RichtigeAntwort
  93. LOCATE 2+ass,18:COLOR 15:PRINT score(ass)
  94. FOR i=1 TO 0 STEP-0.025:PALETTE 15,i,i,i:NEXT i
  95. score(ass)=score(ass)+nun*10
  96. LOCATE 2+ass,18:COLOR 15:PRINT score(ass)
  97. FOR i=0 TO 1 STEP+0.025:PALETTE 15,i,i,i:NEXT i
  98. Okay1:
  99. IF rfu=1 AND ant<>wahr THEN GOSUB Richtiganzeigen
  100. GOSUB Clearen
  101. PALETTE 15,1,1,1
  102. Loop55:
  103. IF wahl>0  THEN check=2:che=wahl
  104. IF wahl>10 THEN check=4:che=wahl-10
  105. IF wahl>20 THEN check=6:che=wahl-20
  106. IF wahl>30 THEN check=8:che=wahl-30
  107. LOCATE 1+check,40+che*3:COLOR ass+2:PRINT pr$
  108. feld(wahl)=1
  109. fertig=fertig+1
  110. IF fertig=40 THEN GOTO Schluss
  111. pr$="·"
  112. NEXT ass
  113. GOTO Start
  114.  
  115. FalscheAntwort:
  116. LOCATE 24,9:COLOR 14
  117. PRINT " Ihre Antwort war leider Inkorrekt.           "
  118. SOUND 261.63,2:SOUND 0,1:SOUND 261.63,2:SOUND 0,1
  119. SOUND 261.63,2:SOUND 220,8
  120. FOR i=1 TO 1700:NEXT i
  121. LOCATE 24,9:PRINT "                                                       "
  122. RETURN
  123.  
  124. RichtigeAntwort:
  125. LOCATE 24,9:COLOR 14
  126. PRINT " Ihre Antwort war Korrekt.                   "
  127. SOUND 261.63,2:SOUND 293.66,2:SOUND 329.63,2:SOUND 392,4
  128. SOUND 329.63,2:SOUND 392,5
  129. FOR i=1 TO 1700:NEXT i
  130. LOCATE 24,9:PRINT "                                                       "
  131. RETURN
  132.  
  133. Risikoda:
  134. SOUND 294,4:SOUND 392,7:SOUND 294,4:SOUND 392,7:SOUND 294,4:SOUND 392,10
  135. IF rju=1 THEN pr$="R"
  136. LOCATE 24,9:COLOR 14:PRINT "                   !¡!   ·RISIKO·   !¡!     "
  137. LOCATE 12,14:COLOR 2+ass:PRINT "Spieler "ass", wieviel wollen Sie setzen ?"
  138. ant$(1)="10 %":ant$(2)="20 %"
  139. ant$(3)="50 %":ant$(4)="75 %"
  140. GOSUB Antworten
  141. sonder=1:ant=1:GOSUB Auswahl:sonder=0
  142. IF ant=1 THEN b=10
  143. IF ant=2 THEN b=20
  144. IF ant=3 THEN b=50
  145. IF ant=4 THEN b=75
  146. a=(score(ass)\100)*b
  147. summe=INT(a)
  148. LOCATE 2+ass,18:COLOR 15:PRINT score(ass)
  149. FOR i=1 TO 0 STEP-0.025:PALETTE 15,i,i,i:NEXT i
  150. score(ass)=score(ass)-summe
  151. LOCATE 2+ass,18:COLOR 15:PRINT score(ass)
  152. FOR i=0 TO 1 STEP+0.025:PALETTE 15,i,i,i:NEXT i
  153. GOSUB Clearen
  154. GOSUB Fragelesen
  155. ok=LEN(frage$)
  156. IF ok<59 THEN FOR i=1 TO 62-ok:frage$=frage$+" ":NEXT i
  157. LOCATE 12,14:COLOR 2:PRINT frage$
  158. GOSUB Antworten
  159. ant=1:GOSUB Auswahl
  160. IF ant<>wahr THEN GOSUB FalscheAntwort:GOTO Risi1
  161. IF ant=wahr THEN GOSUB RichtigeAntwort:GOTO Risi1
  162. Risi1:
  163. IF ant<>wahr THEN GOTO Risi2      
  164. a=summe*2
  165. LOCATE 2+ass,18:COLOR 15:PRINT score(ass)
  166. FOR i=1 TO 0 STEP-0.025:PALETTE 15,i,i,i:NEXT i
  167. score(ass)=score(ass)+a
  168. LOCATE 2+ass,18:COLOR 15:PRINT score(ass)
  169. FOR i=0 TO 1 STEP+0.025:PALETTE 15,i,i,i:NEXT i
  170. Risi2:
  171. IF rfu=1 AND ant<>wahr THEN GOSUB Richtiganzeigen
  172. GOSUB Clearen
  173. GOTO Loop55
  174.  
  175. Jokerda:
  176. IF rju=1 THEN pr$="J"
  177. LOCATE 24,9:COLOR 11:PRINT "          JOKER   ";
  178. COLOR 12:PRINT "JOKER   ";:COLOR 13:PRINT "JOKER   ";
  179. COLOR 12:PRINT "JOKER   ";:COLOR 11:PRINT "JOKER"
  180. LOCATE 2+ass,18:COLOR 15:PRINT score(ass)
  181. FOR i=1 TO 0 STEP-0.025:PALETTE 15,i,i,i:NEXT i
  182. score(ass)=score(ass)+200
  183. SOUND 261.63,2:SOUND 293.66,2:SOUND 329.63,2:SOUND 392,4
  184. SOUND 0,0.5:SOUND 392,3:SOUND 0,0.5:SOUND 392,3:SOUND 349.23,2
  185. SOUND 293.66,2:SOUND 261.63,5
  186. LOCATE 2+ass,18:COLOR 15:PRINT score(ass)
  187. FOR i=0 TO 1 STEP+0.025:PALETTE 15,i,i,i:NEXT i
  188. FOR i=1 TO 1000:NEXT i
  189. LOCATE 24,9:PRINT "                                                              "
  190. GOTO Loop55
  191.                   
  192. Eingabe:
  193. platz=1
  194. LINE (329,12)-(351,27),10,b
  195. Einga1:
  196. xy$=INKEY$
  197. IF xy$=CHR$(127) THEN torf=1:GOTO Neueinstellung
  198. IF xy$=CHR$(139) THEN torf=2:GOTO Neueinstellung
  199. IF xy$=CHR$(129) THEN torf=3:GOTO Neueinstellung
  200. IF xy$=CHR$(136) THEN faab=1:torf=1:GOSUB Farbaendern
  201. IF xy$=CHR$(137) THEN faab=2:torf=1:GOSUB Farbaendern
  202. IF xy$=CHR$(138) THEN faab=3:torf=1:GOSUB Farbaendern
  203. IF xy$="8" THEN faab=1:torf=2:GOSUB Farbaendern
  204. IF xy$="9" THEN faab=2:torf=2:GOSUB Farbaendern
  205. IF xy$="0" THEN faab=3:torf=2:GOSUB Farbaendern
  206. IF xy$=CHR$(133) THEN faab=1:torf=1:GOSUB Farbaendern1
  207. IF xy$=CHR$(134) THEN faab=2:torf=1:GOSUB Farbaendern1
  208. IF xy$=CHR$(135) THEN faab=3:torf=1:GOSUB Farbaendern1
  209. IF xy$="5" THEN faab=1:torf=2:GOSUB Farbaendern1
  210. IF xy$="6" THEN faab=2:torf=2:GOSUB Farbaendern1
  211. IF xy$="7" THEN faab=3:torf=2:GOSUB Farbaendern1
  212. IF STICK(2)=1  THEN a=1:GOTO Einga2
  213. IF STICK(2)=-1 THEN a=2:GOTO Einga2
  214. IF STICK(3)=1 THEN a=3:GOTO Einga2
  215. IF STICK(3)=-1  THEN a=4:GOTO Einga2
  216. IF STRIG(3)<>0 THEN Einga0
  217. GOTO Einga1
  218. Einga2:
  219. IF soo=0 THEN SOUND 200,1:SOUND 300,1
  220. check=platz
  221. IF a=1 THEN platz=platz+1:IF platz=41 THEN platz=1
  222. IF a=2 THEN platz=platz-1:IF platz=0 THEN platz=40
  223. IF a=3 THEN platz=platz+10:IF platz>40 THEN platz=platz-40
  224. IF a=4 THEN platz=platz-10:IF platz<1 THEN platz=platz+40
  225. GOSUB Loeschen
  226. check=platz
  227. IF platz>30 THEN Ein3
  228. IF platz>20 THEN Ein2
  229. IF platz>10 THEN Ein1
  230. LINE (329+((check-1)*24),12)-(351+((check-1)*24),27),10,b
  231. GOTO Ein4
  232. Ein1:
  233. check=check-10
  234. LINE (329+((check-1)*24),28)-(351+((check-1)*24),43),10,b
  235. GOTO Ein4
  236. Ein2:
  237. check=check-20
  238. LINE (329+((check-1)*24),44)-(351+((check-1)*24),59),10,b
  239. GOTO Ein4
  240. Ein3:
  241. check=check-30
  242. LINE (329+((check-1)*24),60)-(351+((check-1)*24),75),10,b
  243. GOTO Ein4
  244. Ein4:
  245. GOTO Einga1
  246. Einga0:
  247. IF soo=0 THEN SOUND 400,1:SOUND 500,1:SOUND 600,1:SOUND 500,1:SOUND 700,1
  248. FOR i=1 TO 0 STEP-0.025:PALETTE 10,0,i,i:NEXT i
  249. FOR i=0 TO 1 STEP+0.025:PALETTE 10,0,i,i:NEXT i
  250. FOR i=1 TO 0 STEP-0.025:PALETTE 10,0,i,i:NEXT i
  251. wahl=platz
  252. check=platz
  253. GOSUB Loeschen
  254. PALETTE 10,0,1,1
  255. RETURN
  256.  
  257. Loeschen:
  258. IF check>30 THEN Loe3
  259. IF check>20 THEN Loe2
  260. IF check>10 THEN Loe1
  261. LINE (329+((check-1)*24),12)-(351+((check-1)*24),27),0,b
  262. RETURN
  263. Loe1:
  264. check=check-10
  265. LINE (329+((check-1)*24),28)-(351+((check-1)*24),43),0,b
  266. RETURN
  267. Loe2:
  268. check=check-20
  269. LINE (329+((check-1)*24),44)-(351+((check-1)*24),59),0,b
  270. RETURN
  271. Loe3:
  272. check=check-30
  273. LINE (329+((check-1)*24),60)-(351+((check-1)*24),75),0,b
  274. RETURN
  275.  
  276. Fehler:
  277. COLOR ass+2:LOCATE 24,9
  278. SOUND 700,5
  279. PRINT "     !¡!  DIESES FELD IST BEREITS EINMAL GEWÄHLT WORDEN  !¡!"
  280. FOR i=0 TO 1 STEP+0.05:PALETTE 0,i,i,i:NEXT i
  281. FOR i=1 TO 0 STEP-0.05:PALETTE 0,i,i,i:NEXT i
  282. FOR i=1 TO 1000:NEXT i
  283. LOCATE 24,9:PRINT "                                                              "
  284. GOTO Okay
  285.  
  286. Fragelesen:
  287. a=INT(max*RND(1))+1
  288. FOR i=1 TO fertig+1:IF a=gen(i) THEN GOTO Fragelesen
  289. NEXT i
  290. gen(fertig+1)=a
  291. a$="Fragen/QM."
  292. b$=STR$(a)
  293. b$=RIGHT$(b$,(LEN(b$)-1))
  294. a$=a$+b$
  295. OPEN a$ FOR INPUT AS 1
  296. INPUT #1,daten$
  297. CLOSE 1
  298. check=1                                                                                 
  299. FOR i=1 TO LEN(daten$)
  300. IF MID$(daten$,i,1)="?" AND check=1 THEN nach=i+1:frage$=MID$(daten$,1,i-1):check=2:GOTO FL
  301. IF MID$(daten$,i,1)="?" AND check=2 THEN ant$(1)=MID$(daten$,nach,i-nach):check=3:nach=i+1:GOTO FL
  302. IF MID$(daten$,i,1)="?" AND check=3 THEN ant$(2)=MID$(daten$,nach,i-nach):check=4:nach=i+1:GOTO FL
  303. IF MID$(daten$,i,1)="?" AND check=4 THEN ant$(3)=MID$(daten$,nach,i-nach):check=5:nach=i+1:GOTO FL
  304. IF MID$(daten$,i,1)="?" AND check=5 THEN ant$(4)=MID$(daten$,nach,i-nach):GOTO FL2
  305. FL:
  306. NEXT i
  307.  
  308. FL2:
  309. wahr$=RIGHT$(daten$,1)
  310. wahr=VAL(wahr$)
  311. frage$=frage$+" ?"
  312. RETURN
  313.  
  314. Auswahl:
  315. flens=0
  316. PALETTE 15,1,1,1
  317. a=INT(TIMER):voll=a+20
  318. IF sonder=1 THEN GOTO Auswahl1
  319. LINE (100,65)-(260,69),11,bf
  320. LINE (100,66)-(260,68),12,bf
  321. LINE (100,67)-(260,67),13
  322. Auswahl1:
  323. IF sonder=0 THEN GOSUB Zeit
  324. LINE (168,86+ant*16)-(LEN(ant$(ant))*8+182,96+ant*16),15,b
  325. Auswa1:
  326. IF sonder=0 THEN GOSUB Zeit
  327. IF STICK(3)=-1 THEN GOSUB Auswa3:ant=ant-1:GOTO Auswa2
  328. IF STICK(3)=1  THEN GOSUB Auswa3:ant=ant+1:GOTO Auswa2
  329. IF STRIG(3)<>0 THEN GOTO Auswa4
  330. GOTO Auswa1
  331. Auswa2:
  332. IF ant=0 THEN ant=4
  333. IF ant=5 THEN ant=1
  334. GOTO Auswahl1
  335. Auswa3:
  336. LINE (168,86+ant*16)-(LEN(ant$(ant))*8+182,96+ant*16),0,b
  337. RETURN
  338. Auswa4:
  339. FOR i=1 TO 0 STEP -0.05:PALETTE 15,i,i,i:NEXT i
  340. FOR i=0 TO 1 STEP +0.05:PALETTE 15,i,i,i:NEXT i
  341. FOR i=1 TO 0 STEP -0.05:PALETTE 15,i,i,i:NEXT i
  342. LINE (168,86+ant*16)-(LEN(ant$(ant))*8+182,96+ant*16),0,b
  343. PALETTE 15,1,1,1
  344. LINE (100,65)-(260,69),0,bf
  345. RETURN
  346.  
  347. Zeit:
  348. nun=voll-INT(TIMER)
  349. IF nun<1 THEN nun=0.5
  350. IF nun=0.5 AND flens=0 THEN SOUND 165,5:SOUND 195,2:SOUND 165,5:flens=1
  351. LINE (260-(20-nun)*8,64)-(260,70),0,bf
  352. RETURN
  353.  
  354. Antworten:
  355. COLOR 9
  356. LOCATE 14,23:PRINT ant$(1)
  357. LOCATE 16,23:PRINT ant$(2)
  358. LOCATE 18,23:PRINT ant$(3)
  359. LOCATE 20,23:PRINT ant$(4)
  360. RETURN
  361.  
  362. Clearen:
  363. LOCATE 12,14
  364. PRINT "                                                              "
  365. LINE (166,102)-(580,160),0,bf
  366. RETURN 
  367.  
  368. Neueinstellung:
  369. SOUND 100+torf*100,1
  370. IF torf=1 AND rju=0 THEN rju=1:LOCATE 4,75:COLOR 1,8:PRINT "U":COLOR 3,0:GOTO Neueinst
  371. IF torf=1 AND rju=1 THEN rju=0:LOCATE 4,75:COLOR 1,8:PRINT " ":COLOR 3,0:GOTO Neueinst
  372. IF torf=2 AND rfu=0 THEN rfu=1:LOCATE 8,75:COLOR 1,8:PRINT "R":COLOR 3,0:GOTO Neueinst
  373. IF torf=2 AND rfu=1 THEN rfu=0:LOCATE 8,75:COLOR 1,8:PRINT " ":COLOR 3,0:GOTO Neueinst
  374. IF torf=3 AND soo=0 THEN soo=1:LOCATE 6,75:COLOR 1,8:PRINT "S":COLOR 3,0:GOTO Neueinst
  375. IF torf=3 AND soo=1 THEN soo=0:LOCATE 6,75:COLOR 1,8:PRINT " ":COLOR 3,0:GOTO Neueinst
  376. Neueinst:
  377. GOTO Einga1
  378.  
  379. Richtiganzeigen:
  380. PALETTE 15,0.75,0.75,0.75:COLOR 15
  381. IF wahr<>1 THEN LOCATE 14,23:PRINT ant$(1)
  382. IF wahr<>2 THEN LOCATE 16,23:PRINT ant$(2)
  383. IF wahr<>3 THEN LOCATE 18,23:PRINT ant$(3)
  384. IF wahr<>4 THEN LOCATE 20,23:PRINT ant$(4)
  385. FOR i=0.75 TO 0 STEP-0.03:PALETTE 15,i,i,i
  386. IF soo=0 THEN SOUND 200+i*200,0.3
  387. IF soo=1 THEN SOUND 0,1
  388. NEXT i
  389. FOR i=1 TO 1000:NEXT i
  390. RETURN
  391.  
  392. Farbaendern:
  393. IF torf=1 THEN pal(faab)=pal(faab)+0.05:IF pal(faab)>1 THEN pal(faab)=1
  394. IF torf=2 THEN pal(faab)=pal(faab)-0.05:IF pal(faab)<0 THEN pal(faab)=0
  395. PALETTE 1,pal(1),pal(2),pal(3)
  396. RETURN
  397.  
  398. Farbaendern1:
  399. IF torf=1 THEN pala(faab)=pala(faab)+0.05:IF pala(faab)>1 THEN pala(faab)=1
  400. IF torf=2 THEN pala(faab)=pala(faab)-0.05:IF pala(faab)<0 THEN pala(faab)=0
  401. PALETTE 8,pala(1),pala(2),pala(3)
  402. RETURN
  403.  
  404. Schluss:
  405. FOR i=1 TO 2500:NEXT i
  406. GOSUB Rollen
  407. OPEN "df0:Data/QM.high" FOR INPUT AS 1
  408. FOR i=1 TO 4:INPUT #1,high(i):NEXT i:CLOSE 1
  409. OPEN "df0:Data/QM.namen" FOR INPUT AS 1
  410. FOR i=1 TO 4:INPUT #1,namen$(i):NEXT i:CLOSE 1
  411. GOSUB Rollen1
  412. IF anz=2 THEN GOTO Zweier2
  413. IF anz=3 THEN GOTO Dreier3
  414. IF anz=4 THEN GOTO Vierer4
  415.  
  416. Einser1:
  417. CLS
  418. modus=1:sieger=1:GOSUB Spielerschrift
  419. LOCATE 12,2:COLOR 15:PRINT "Sie erreichten"score(1)"Punkte."
  420. IF score(1)>high(1) THEN GOTO Eintragung
  421. GOTO Abfrageamende
  422.  
  423. Zweier2:
  424. CLS
  425. IF score(1)>score(2) THEN sieger=1
  426. IF score(2)>score(1) THEN sieger=2
  427. IF score(1)=score(2) THEN GOTO Unentschieden
  428. GOSUB Spielerschrift
  429. LOCATE 12,2:COLOR 15
  430. IF sieger=1 THEN PRINT "Spieler 1 besiegte Spieler 2 mit einen Vorsprung von "score(1)-score(2)"."
  431. IF sieger=2 THEN PRINT "Spieler 2 besiegte Spieler 1 mit einen Vorsprung von "score(2)-score(1)"."
  432. FOR i=1 TO 0 STEP-0.02:PALETTE 15,i,i,i:NEXT i
  433. FOR i=0 TO 1 STEP+0.02:PALETTE 15,i,i,i:NEXT i:PRINT:PRINT:PRINT
  434. modus=2
  435. IF score(sieger)>high(2) THEN GOTO Eintragung
  436. GOTO Abfrageamende
  437.  
  438. Dreier3:
  439. CLS:modus=3
  440. IF score(1)=score(2) OR score(1)=score(3) OR score(2)=score(3) THEN GOTO Unentschieden
  441. IF score(1)>score(2) AND score(1)>score(3) THEN sieger=1
  442. IF score(2)>score(1) AND score(2)>score(3) THEN sieger=2
  443. IF score(3)>score(1) AND score(1)>score(2) THEN sieger=3
  444. GOSUB Spielerschrift
  445. LOCATE 12,2:COLOR 15
  446. PRINT "Spieler"sieger"gewinnt mit"score(sieger)"Punkten."
  447. IF score(sieger)>high(3) THEN GOTO Eintragung
  448. GOTO Abfrageamende
  449.  
  450. Vierer4:
  451. CLS:modus=4
  452. IF score(1)=score(2) OR score(1)=score(3) OR score(1)=score(4) THEN GOTO Unentschieden
  453. IF score(2)=score(3) OR score(2)=score(4) OR score(3)=score(4) THEN GOTO Unentschieden
  454. IF score(1)>score(2) AND score(1)>score(3) AND score(1)>score(4) THEN sieger=1
  455. IF score(2)>score(1) AND score(2)>score(3) AND score(2)>score(4) THEN sieger=2
  456. IF score(3)>score(2) AND score(3)>score(1) AND score(3)>score(4) THEN sieger=3
  457. IF score(4)>score(2) AND score(4)>score(3) AND score(4)>score(1) THEN sieger=4
  458. GOSUB Spielerschrift
  459. LOCATE 12,2:COLOR 15
  460. PRINT "Spieler"sieger"gewinnt mit"score(sieger)"Punkten."
  461. IF score(sieger)>high(4) THEN GOTO Eintragung
  462. GOTO Abfrageamende
  463.  
  464. Spielerschrift:
  465. COLOR 2+sieger   
  466. PRINT "             ___   ___  _   ___       ___  ___
  467. PRINT "            |     |   | |  |    |    |    |   |
  468. PRINT "            |___  |___| |  |_   |    |_   |___|
  469. PRINT "                | |     |  |    |    |    | \
  470. PRINT "             ___| |    _|_ |___ |___ |___ |  \
  471. PALETTE 11,0,0.4,0.4
  472. PALETTE 12,0,0.6,0.6
  473. PALETTE 13,0,1,1
  474. LINE (0,60)-(640,64),11,bf
  475. LINE (0,61)-(640,63),12,bf
  476. LINE (0,62)-(640,62),13
  477. IF sieger=1 THEN GOSUB Oins
  478. IF sieger=2 THEN GOSUB Zwoi
  479. IF sieger=3 THEN GOSUB Droi
  480. IF sieger=4 THEN GOSUB Vuer
  481. RETURN
  482.  
  483. Oins:
  484. LOCATE 1,52:PRINT "  _"
  485. LOCATE 2,52:PRINT " /|"
  486. LOCATE 3,52:PRINT "/ |"
  487. LOCATE 4,52:PRINT "  |"
  488. LOCATE 5,52:PRINT " _|_"
  489. RETURN
  490. Zwoi:
  491. LOCATE 1,52:PRINT " ___ "
  492. LOCATE 2,52:PRINT "    |"
  493. LOCATE 3,52:PRINT " ___|"
  494. LOCATE 4,52:PRINT "|    "
  495. LOCATE 5,52:PRINT "|___ "
  496. RETURN
  497. Droi:
  498. LOCATE 1,52:PRINT "___ "
  499. LOCATE 2,52:PRINT "   |"
  500. LOCATE 3,52:PRINT "___|"
  501. LOCATE 4,52:PRINT "   |"
  502. LOCATE 5,52:PRINT "___|"
  503. RETURN
  504. Vuer:
  505. LOCATE 1,52:PRINT "     "
  506. LOCATE 2,52:PRINT "|   |"
  507. LOCATE 3,52:PRINT "|___|_"
  508. LOCATE 4,52:PRINT "    |"
  509. LOCATE 5,52:PRINT "    |"
  510. RETURN
  511.  
  512. Eintragung:
  513. COLOR 15:PRINT " Spieler"sieger", Sie haben eine neue High-Score aufgestellt..."
  514. PRINT
  515. PRINT "  Alte High-Score: "high(modus)
  516. PRINT "  Neue High-Score: "score(sieger)
  517. high(modus)=score(sieger)
  518. SOUND 261.63,9:SOUND 0,1:SOUND 261.63,5:SOUND 0,1
  519. SOUND 261.63,2:SOUND 0,1:SOUND 261.63,8:SOUND 196,7
  520. SOUND 329.63,9:SOUND 0,1:SOUND 329.63,5:SOUND 0,1
  521. SOUND 329.63,2:SOUND 0,1:SOUND 329.63,8:SOUND 261.63,7
  522. SOUND 392,15:SOUND 290,13:SOUND 261.63,15
  523. Lopop:
  524. COLOR 15:PRINT
  525. PRINT " Tragen Sie nun Ihren Namen ein, Spieler"sieger;:COLOR 2+sieger
  526. INPUT "> ",namen$(modus)
  527. IF LEN(namen$)>10 THEN PRINT :PRINT "ZU LANG !!!":GOTO Lopop
  528. OPEN "df0:Data/QM.high" FOR OUTPUT AS 1
  529. FOR i=1 TO 4:PRINT #1,high(i):NEXT i:CLOSE 1
  530. OPEN "df0:Data/QM.namen" FOR OUTPUT AS 1
  531. FOR i=1 TO 4:PRINT #1,namen$(i):NEXT i:CLOSE 1
  532. GOTO Ende
  533.  
  534. Ende:
  535. CLS:PRINT:COLOR 2
  536. PRINT " Ende dieses Spiels."
  537. PRINT:PRINT
  538. PRINT "  Highscores:":PRINT
  539. COLOR 3:PRINT "         1-Spieler-Modus: "namen$(1)" mit"high(1)" Punkten."
  540. COLOR 4:PRINT "         2-Spieler-Modus: "namen$(2)" mit"high(2)" Punkten."
  541. COLOR 5:PRINT "         3-Spieler-Modus: "namen$(3)" mit"high(3)" Punkten."
  542. COLOR 6:PRINT "         4-Spieler-Modus: "namen$(4)" mit"high(4)" Punkten."
  543. PRINT:PRINT:PRINT:PRINT:COLOR 2
  544. FOR i=1 TO 3000:NEXT i
  545. PRINT " Noch ein Spiel (J/N) ?"
  546. Ende1:
  547. a$=INKEY$:IF a$="" THEN Ende1
  548. IF a$="n" THEN GOTO AbsolutesEnde
  549. IF a$="j" THEN RUN
  550. GOTO Ende1
  551.  
  552. Unentschieden:
  553. CLS
  554. COLOR 15
  555. PRINT "                     __       _____  __  __       _  __  _    __
  556. PRINT "        |   | |   | |   |   |   |   |   |  | |  | | |   | \  |   |   |
  557. PRINT "        |   | |\  | |_  |\  |   |   |_  |    |__| | |_  |  | |_  |\  |
  558. PRINT "        |   | | \ | |   | \ |   |     | |    |  | | |   |  | |   | \ |
  559. PRINT "        |___| |  \| |__ |  \|   |   __| |__| |  | | |__ |_/  |__ |  \|
  560. PRINT:PRINT
  561. FOR i=1 TO 0 STEP-0.02:PALETTE 15,i,i,i:NEXT i
  562. FOR i=0 TO 1 STEP+0.02:PALETTE 15,i,i,i:NEXT i
  563. PRINT:COLOR 3:PRINT "   Spieler 1 erreichte"score(1)"Punkte."
  564. PRINT:COLOR 4:PRINT "   Spieler 2 erreichte"score(2)"Punkte."
  565. IF anz>2 THEN PRINT:COLOR 5:PRINT "   Spieler 3 erreichte"score(3)"Punkte."
  566. IF anz>3 THEN PRINT:COLOR 6:PRINT "   Spieler 4 erreichte"score(4)"Punkte."          
  567. PRINT:GOTO Abfrageamende
  568.  
  569. Abfrageamende:
  570. SOUND 392,6:SOUND 515,7:SOUND 392,2:SOUND 440,4:SOUND 349.23,4
  571. SOUND 293.66,7:SOUND 392,6:SOUND 329.63,3:SOUND 261.63,4
  572. SOUND 329.63,4:SOUND 293.66,7:SOUND 0,3
  573. SOUND 392,6:SOUND 515,7:SOUND 392,2:SOUND 440,4:SOUND 349.23,4
  574. SOUND 293.66,7:SOUND 392,6:SOUND 329.63,3:SOUND 261.63,4
  575. SOUND 261.63,1:SOUND 293.66,4:SOUND 261.63,10
  576. FOR i=1 TO 6000:NEXT i
  577. GOTO Ende
  578.  
  579. AbsolutesEnde:
  580. CLS:PALETTE 15,0,0,0:COLOR 15:PRINT
  581. PRINT " Dank an (alphabetisch sortiert...)"
  582. PRINT
  583. PRINT "       -  Andreas"  
  584. PRINT "       -  Bianca"
  585. PRINT "       -  Peter"
  586. PRINT "       -  Rolf"
  587. PRINT 
  588. PRINT " für die Hilfe beim Erstellen der Fragen und fürs Testspielen."
  589. PRINT:PALETTE 2,0,0,0:PALETTE 3,1,1,1
  590. PRINT:COLOR 2
  591. PRINT "   written in 1989 by Florian Zöllner"
  592. FOR i=1 TO 1000:NEXT i
  593. FOR i=0 TO 1 STEP+0.01:PALETTE 15,0,0,i:NEXT i
  594. FOR i=1 TO 4000:NEXT i
  595. FOR t=1 TO 3
  596. FOR i=0 TO 1 STEP+0.015:PALETTE 2,i,i,i:NEXT i
  597. FOR i=1 TO 0 STEP-0.015:PALETTE 2,i,i,i:NEXT i
  598. NEXT t:PRINT:PRINT:PRINT:COLOR 3
  599. FOR i=1 TO 1000:NEXT i
  600. PALETTE 13,0,0,0.35
  601. FOR i=0 TO 0.5 STEP+0.005:PALETTE 2,i,0,i:NEXT i
  602. FOR i=0 TO 1 STEP+0.015:PALETTE 15,0,i,1:NEXT i
  603. FOR i=0 TO 1 STEP+0.015:PALETTE 1,i,i,i:NEXT i
  604. FOR i=0 TO 0.35 STEP+0.005:PALETTE 0,0,0,i:NEXT i
  605. LOCATE 12,3:COLOR 2,13:PRINT " written in 1989 by Florian Zöllner ":COLOR 1,0
  606. PRINT:PRINT:PRINT " Ende.":PRINT
  607. FOR i=0 TO 1 STEP+0.015:PALETTE 13,i,i,0.35:NEXT i
  608. END
  609.  
  610. Rollen:
  611. FOR i=0 TO 215 STEP+5
  612. LINE (0,i)-(640,i+4),11,bf
  613. LINE (0,i+1)-(640,i+3),12,bf
  614. LINE (0,i+2)-(640,i+2),13
  615. NEXT i
  616. RETURN
  617. Rollen1:
  618. FOR i=220 TO 1 STEP-1
  619. LINE (0,i-1)-(640,i-1),13
  620. LINE (0,i)-(640,i),0
  621. NEXT i
  622. RETURN
  623.